home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / macgambit-20-compiler-src-p1 / Examples / window-demo.scm < prev   
Encoding:
Text File  |  1994-07-26  |  2.6 KB  |  77 lines  |  [TEXT/gamI]

  1. ; This is a small demo that shows how to interface to the "high-level"
  2. ; window manager.  Events generated for the sample window are simply
  3. ; displayed as they are received.
  4.  
  5. (define (make-sample-window rect name)
  6.  
  7.   ; First, create the Macintosh window
  8.  
  9.   (let ((w (mac#newwindow rect name #t 4 -1 #t)))
  10.  
  11.     ; These procedures handle the events generated by the Macintosh
  12.  
  13.     (define (mousedown pt modifiers) (show "mousedown"  #f modifiers pt))
  14.     (define (mouseup pt modifiers)   (show "mouseup"    #f modifiers pt))
  15.     (define (keydown ch modifiers)   (show "keydown"    ch modifiers #f))
  16.     (define (keyup ch modifiers)     (show "keyup"      ch modifiers #f))
  17.     (define (autokey ch modifiers)   (show "autokey"    ch modifiers #f))
  18.     (define (goaway)                 (bye))
  19.     (define (update)                 (show "update"     #f #f        #f))
  20.     (define (activate)               (show "activate"   #f #f        #f))
  21.     (define (deactivate)             (show "deactivate" #f #f        #f))
  22.  
  23.     ; Utilities for above
  24.  
  25.     (define event-count 0)
  26.  
  27.     (define (show event-name char modifiers pt)
  28.       (set! event-count (+ event-count 1))
  29.       (mac#eraserect w (mac#rect -32000 -32000 32000 32000))
  30.       (mac#moveto w 10 20)
  31.       (mac#drawstring w "event #")
  32.       (mac#drawstring w (number->string event-count))
  33.       (mac#drawstring w ": ")
  34.       (mac#drawstring w event-name)
  35.       (if char
  36.         (begin
  37.           (mac#drawstring w "   ")
  38.           (mac#drawchar w char)))
  39.       (if modifiers
  40.         (begin
  41.           (mac#drawstring w "   ")
  42.           (mac#drawstring w (number->string modifiers))))
  43.       (if pt
  44.         (let ((h (mac#point-h pt)) (v (mac#point-v pt)))
  45.           (mac#lineto w h v)
  46.           (mac#paintoval w (mac#rect (- v 3) (- h 3) (+ v 3) (+ h 3))))))
  47.  
  48.     (define (bye)
  49.       (mac#window-unbind w)
  50.       (mac#disposewindow w))
  51.  
  52.     ; Create high-level window object
  53.  
  54.     (define (wind msg)
  55.       (case msg
  56.         ((MOUSEDOWN)  mousedown)
  57.         ((MOUSEUP)    mouseup)
  58.         ((KEYDOWN)    keydown)
  59.         ((KEYUP)      keyup)
  60.         ((AUTOKEY)    autokey)
  61.         ((GOAWAY)     goaway)
  62.         ((UPDATE)     update)
  63.         ((ACTIVATE)   activate)
  64.         ((DEACTIVATE) deactivate)
  65.         (else         (error "Unknown window message:" msg))))
  66.  
  67.     ; If window was created, announce its presence to the window manager
  68.  
  69.     (if (= w 0)
  70.       (error "Window could not be created (out of memory?)")
  71.       (begin
  72.         (mac#window-bind w wind)
  73.         wind))))
  74.  
  75. (make-sample-window (mac#rect 130 10 330 310) "Sample 2")
  76. (make-sample-window (mac#rect 50 200 250 500) "Sample 1")
  77.